home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0040_Environment Settings.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  2KB  |  113 lines
  1. {
  2. > Who has PTENV.PAS
  3.  
  4. Here is how it works:
  5. }
  6. UNIT SetEnvir;
  7.  
  8. INTERFACE
  9.  
  10.  
  11. USES
  12.   DOS;
  13.  
  14.  
  15. TYPE
  16.   EnvSize = 0..16383;
  17.  
  18.  
  19. PROCEDURE SetEnv(EnvVar, Value : STRING);
  20.  
  21. {-----------------------------------------------------------------------
  22.  This procedure may be used to setup or change environment variables
  23.  in the environment of the resident copy of COMMAND.COM or 4DOS.COM
  24.  
  25.  Note that this will be the ACTIVE copy of the command interpreter, NOT
  26.  the primary copy!
  27.  
  28.  This unit is not tested under DR-DOS.
  29.  
  30.  Any call of SetEnv must be followed by checking ioresult. The procedure
  31.  may return error 8 (out of memory) on too less space in te environment.
  32. -----------------------------------------------------------------------}
  33.  
  34. IMPLEMENTATION
  35.  
  36. PROCEDURE SetEnv(EnvVar, Value : STRING);
  37. VAR
  38.   Link,
  39.   PrevLink,
  40.   EnvirP   : word;
  41.   Size,
  42.   Scan,
  43.   Where,
  44.   Dif      : integer;
  45.   NewVar,
  46.   OldVar,
  47.   Test     : STRING;
  48.  
  49.   FUNCTION CheckSpace(Wanted : integer) : boolean;
  50.   BEGIN
  51.     IF wanted + Scan > Size THEN
  52.       inoutres := 8;
  53.     CheckSpace := inoutres = 0;
  54.   END;
  55.  
  56. BEGIN
  57.   IF inoutres >0 THEN
  58.     Exit;
  59.   FOR Scan := 1 TO Length(EnvVar) DO
  60.     EnvVar[Scan] := UpCase(EnvVar[Scan]);
  61.   EnvVar := EnvVar + '=';
  62.   NewVar := EnvVar + Value + #0;
  63.   link   := PrefixSeg;
  64.  
  65.   REPEAT
  66.     PrevLink := Link;
  67.     Link := memw [link : $16];
  68.   UNTIL Link = prevlink;
  69.  
  70.   EnvirP := memw [Link : $2C];
  71.   Size   := memw [Envirp - 1 : $03] * 16;
  72.   Scan   := 0;
  73.   Where  := -1;
  74.   WHILE mem[EnvirP : Scan] <> 0 DO
  75.   BEGIN
  76.     move(mem[EnvirP : scan], Test[1], 255);
  77.     Test[0] := #255;
  78.     Test[0] := chr(pos(#0, Test));
  79.     IF pos(EnvVar, Test) = 1 THEN
  80.     BEGIN
  81.       Where  := Scan;
  82.       OldVar := Test;
  83.     END;
  84.     Scan := Scan + Length(Test);
  85.   END;
  86.  
  87.   IF Where = -1 THEN
  88.   BEGIN
  89.     Where  := Scan;
  90.     NewVar := NewVar + #0#0#0;
  91.     IF NOT CheckSpace(Length(NewVar)) THEN
  92.       Exit;
  93.   END
  94.   ELSE
  95.   BEGIN
  96.     Dif := Length(NewVar) - Length(OldVar);
  97.     IF Dif > 0 THEN
  98.     BEGIN
  99.       IF NOT CheckSpace(Dif) THEN
  100.         Exit;
  101.       move(mem[EnvirP : Where], mem[EnvirP : Where + Dif], Scan - Where + 3);
  102.     END
  103.     ELSE
  104.     IF Dif < 0 THEN
  105.       move(mem[EnvirP : Where - Dif], mem[EnvirP : Where], Size - Where + Dif);
  106.   END;
  107.  
  108.   move(NewVar[1], mem[EnvirP : Where], Length(NewVar));
  109. END;
  110.  
  111. END.
  112.  
  113.